home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Scrollbar.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  4.0 KB  |  134 lines
  1. ;;;;
  2. ;;;; S c r o l l b a r . s t k       --  Scrollbar class definition
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date:  5-Mar-1994 17:19
  16. ;;;; Last file update:  1-Jan-1996 18:35
  17.  
  18. (require "Basics")
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;;;
  22. ;;;; <Scrollbar> class
  23. ;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (define-class <Scrollbar> (<Tk-simple-widget>)
  27.   ((active-background    :accessor     active-background
  28.              :init-keyword :active-background
  29.              :tk-name      activebackground
  30.              :allocation   :tk-virtual)
  31.    (active-relief        :accessor     active-relief
  32.              :init-keyword :active-relief
  33.              :tk-name      activerelief
  34.              :allocation   :tk-virtual)
  35.    (command              :accessor     command
  36.              :init-keyword :command
  37.              :allocation   :tk-virtual)  
  38.    (element-border-width :accessor     element-border-width
  39.              :init-keyword :element-border-width
  40.              :tk-name      elementborderwidth
  41.              :allocation   :tk-virtual)
  42.    (jump              :accessor     jump
  43.              :init-keyword :jump
  44.              :allocation   :tk-virtual)
  45.    (orientation          :accessor     orientation
  46.              :init-keyword :orientation
  47.              :tk-name      orient
  48.              :allocation   :tk-virtual)
  49.    (repeat-delay         :accessor     repeat-delay
  50.              :init-keyword :repeat-delay
  51.              :tk-name       repeatdelay
  52.              :allocation   :tk-virtual)
  53.    (repeat-interval      :accessor     repeat-interval
  54.              :init-keyword :repeat-interval
  55.              :tk-name      repeatinterval
  56.              :allocation   :tk-virtual)
  57.    (trough-color         :accessor     trough-color
  58.              :init-keyword :trough-color
  59.              :tk-name      troughcolor
  60.              :allocation   :tk-virtual)
  61.    (width              :accessor     width
  62.              :init-keyword :width
  63.              :allocation   :tk-virtual)
  64.    ;; Fictive slot 
  65.    (value             :accessor     value
  66.              :init-keyword :value
  67.              :allocation   :virtual
  68.              :slot-ref     (lambda (o)  
  69.                      ((slot-ref o 'Id) 'get))
  70.              :slot-set!    (lambda (o v) 
  71.                      (apply (slot-ref o 'Id) 'set v)))))
  72.  
  73. (define-method tk-constructor ((self <Scrollbar>))
  74.   Tk:scrollbar)
  75.  
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. ;;;;
  78. ;;;; Scrollbar Methods
  79. ;;;;
  80. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  81.  
  82. (define-method initialize ((self <Scrollbar>) args)
  83.   (next-method)
  84.   (let ((val (get-keyword :value args #f)))
  85.     ;; If a value is specified at init-time init, set it.
  86.     (when val 
  87.       (set! (value self) val))))
  88.  
  89. ;;;
  90. ;;; Activate
  91. ;;;
  92. (define-method  activate ((self <Scrollbar>))
  93.   ((slot-ref self 'Id) 'activate))
  94.  
  95. (define-method  activate ((self <Scrollbar>) element)
  96.   ((slot-ref self 'Id) 'activate element))
  97.  
  98. ;;;
  99. ;;; Scrollbar-delta
  100. ;;;
  101. (define-method scrollbar-delta ((self <Scrollbar>) delta-x delta-y)
  102.   ((slot-ref self 'Id) 'delta delta-x delta-y))
  103.  
  104. ;;;
  105. ;;; Scrollbar-fraction
  106. ;;;
  107. (define-method scrollbar-fraction ((self <Scrollbar>) x y)
  108.   ((slot-ref self 'Id) 'fraction x y))
  109.  
  110. ;;;
  111. ;;; Scrollbar-identify
  112. ;;;
  113. (define-method scrollbar-identify ((self <Scrollbar>) x y)
  114.   ((slot-ref self 'Id) 'identify x y))
  115.  
  116. ;;;
  117. ;;; Scrollbar-get
  118. ;;;
  119. (define-method scrollbar-get ((self <Scrollbar>))
  120.   ((slot-ref self 'Id) 'get))
  121.  
  122. ;;;
  123. ;;; Scrollbar-set!
  124. ;;;
  125. (define-method scrollbar-set! ((self <Scrollbar>) x y z w) ; old syntax
  126.   ((slot-ref self 'Id) 'set x y z w))
  127.  
  128. (define-method scrollbar-set! ((self <Scrollbar>) x y) ; new syntax
  129.   ((slot-ref self 'Id) 'set x y))
  130.  
  131.  
  132.  
  133. (provide "Scrollbar")
  134.